perm filename CLIPER.SAI[1,BGB] blob sn#001266 filedate 1972-10-22 generic text, type T, neo UTF8
00100	ENTRY CLIPER;
00200	BEGIN	"CLIPPER"
00300		DEFINE α="COMMENT";
00350	α CLIPER ARGUMENTS;
00400		EXTERNAL INTEGER XL,YL,XH,YH;		α THE WINDOW;
00450		EXTERNAL REAL SX,SY,SZ;			α THE SCALES;
00475		EXTERNAL REAL FOCAL;
00500		EXTERNAL REAL X1,Y1,Z1,X2,Y2,Z2;	α THE LINE SEGMENT;
00600		EXTERNAL INTEGER XX1,YY1,XX2,YY2;	α THE CLIPPED LINE SEGMENT;
00700		INTEGER QNE,QNW,QSW,QSE;
00900	α CLIPER RETURNS:
01000		0  -  BOTH ENDS WITHIN.
01100		1  -  END1 WITHIN.
01200		2  -  END2 WITHIN.
01300		3  -  EDGE HITS BUT BOTH ENDS OUT.
01400		4  -  COMPLETE MISS  -  WINDOW IS EXTERIOR WRT THE LINE SEGMENT.
01500		5  -  COMPLETE MISS  -  WINDOW IS NOT EXTERIOR;
01600	α THE CLIPER;
01700		INTERNAL INTEGER PROCEDURE CLIPER;
01800	BEGIN
02000		INTEGER A,B,C,AXL,AXH,BYL,BYH,IN1,IN2;
02100		LABEL NOSHOW;
02200	α Z CLIPPING IF NECESSARY;
02300		IF Z1>0 ∧ Z2>0 THEN RETURN(4);				α INTERIOR SIDED OUTSIDER;
02400		IF Z2>0 THEN
02500	BEGIN
02550		REAL X,Y,Z,DZ;
02600		Z	←	SZ/Z1;
02700		Y	←	Y1*Z/SY;
02800		X	←	X1*Z/SX;
02900		DZ	←	(FOCAL+Z)/(FOCAL+Z-Z2);
03000		X2	←	(X2-X)*DZ + X;
03100		Y2	←	(Y2-Y)*DZ + Y;
03200		X2	←	-X2*SX/FOCAL;
03300		Y2	←	-Y2*SY/FOCAL;
03400	END;
03500		IF Z1>0 THEN
03600	BEGIN
03650		REAL X,Y,Z,DZ;
03700		Z	←	SZ/Z2;
03800		Y	←	Y2*Z/SY;
03900		X	←	X2*Z/SX;
04000		DZ	←	(FOCAL+Z)/(FOCAL+Z-Z1);
04100		X1	←	(X1-X)*DZ + X;
04200		Y1	←	(Y1-Y)*DZ + Y;
04300		X1	←	-X1*SX/FOCAL;
04400		Y1	←	-Y1*SY/FOCAL;
04500	END;
     

00100	α EASY INSIDERS;
00200		IN1	←	XL≤X1 ∧ X1≤XH ∧ YL≤Y1 ∧ Y1≤YH;
00300		IN2	←	XL≤X2 ∧ X2≤XH ∧ YL≤Y2 ∧ Y2≤YH;
00400		IF IN1 ∧ IN2 THEN
00500	BEGIN
00600		XX1	←	X1;
00700		YY1	←	Y1;
00800		XX2	←	X2;
00900		YY2	←	Y2;
01000		RETURN(0);						α BOTH WITHIN;
01100	END;
01200	α LINE COEFFICIENTS, INTERIOR TO THE LEFT IS POSITIVE;
01300		A	←	Y1 - Y2;
01400		B	←	X2 - X1;
01500		C	←	X1*Y2 - X2*Y1;
01600	α PARTIAL PRODUCTS;
01700		AXL	←	A*XL;
01800		AXH	←	A*XH;
01900		BYL	←	B*YL;
02000		BYH	←	B*YH;
02100	α CORNER Q'S;
02200		QNE	←	AXH + BYH + C;
02300		QNW	←	AXL + BYH + C;
02400		QSW	←	AXL + BYL + C;
02500		QSE	←	AXH + BYL + C;
02600	α EASY OUTSIDERS;
02700		IF X1>XH ∧ X2>XH  ∨
02800		   X1<XL ∧ X2<XL  ∨
02900		   Y1<YL ∧ Y2<YL  ∨
03000		   Y1>YH ∧ Y2>YH  THEN GO NOSHOW;
     

00100	α SIDE CROSSINGS;
00200		DEFINE	N? = "QNE⊗QNW<0";
00300		DEFINE	S? = "QSE⊗QSW<0";
00400		DEFINE	E? = "QNE⊗QSE<0";
00500		DEFINE	W? = "QNW⊗QSW<0";
00600	
00700		DEFINE EAST1 = "BEGIN XX1 ← XH; YY1 ← -(AXH + C)/B END";
00800		DEFINE WEST1 = "BEGIN XX1 ← XL; YY1 ← -(AXL + C)/B END";
00900		DEFINE NORTH1 = "BEGIN XX1 ← -(BYH + C)/A; YY1 ← YH END";
01000		DEFINE SOUTH1 = "BEGIN XX1 ← -(BYL + C)/A; YY1 ← YL END";
01100	
01200		DEFINE EAST2 = "BEGIN XX2 ← XH; YY2 ← -(AXH + C)/B END";
01300		DEFINE WEST2 = "BEGIN XX2 ← XL; YY2 ← -(AXL + C)/B END";
01400		DEFINE NORTH2 = "BEGIN XX2 ← -(BYH + C)/A; YY2 ← YH END";
01500		DEFINE SOUTH2 = "BEGIN XX2 ← -(BYL + C)/A; YY2 ← YL END";
     

00100	α SINGLE CROSSER END1 WITHIN;
00200	IF IN1		THEN
00300	BEGIN
00400		IF E?		THEN
00500		IF X2>XH	THEN	EAST2	ELSE
00600		IF N?		THEN	NORTH2	ELSE
00700		IF S?		THEN	SOUTH2	ELSE	WEST2	ELSE
00800		IF N?		THEN
00900		IF Y2>YH	THEN	NORTH2	ELSE
01000		IF S?		THEN	SOUTH2	ELSE	WEST2	ELSE
01100		IF XL>X2	THEN	WEST2	ELSE	SOUTH2;
01200		XX1	←	X1;
01300		YY1	←	Y1;
01400		RETURN(1);
01500	END	ELSE
01600	α SINGLE CROSSER END2 WITHIN;
01700	IF IN2		THEN
01800	BEGIN
01900		IF E?		THEN
02000		IF X1>XH	THEN	EAST1	ELSE
02100		IF N?		THEN	NORTH1	ELSE
02200		IF S?		THEN	SOUTH1	ELSE	WEST1	ELSE
02300		IF N?		THEN
02400		IF Y1>YH	THEN	NORTH1	ELSE
02500		IF S?		THEN	SOUTH1	ELSE	WEST1	ELSE
02600		IF XL>X1	THEN	WEST1	ELSE	SOUTH1;
02700		XX2	←	X2;
02800		YY2	←	Y2;
02900		RETURN(2);
03000	END	ELSE
03100	α DOUBLE CROSSER;
03200	IF E?		THEN
03300	BEGIN
03400		EAST1;
03500		IF N?	THEN	NORTH2	ELSE
03600		IF S?	THEN	SOUTH2	ELSE	WEST2;
03700	END		ELSE
03800	IF N?		THEN
03900	BEGIN
04000		NORTH1;
04100		IF S?	THEN	SOUTH2	ELSE	WEST2;
04200	END	ELSE
04300		IF W?	THEN	
04400	BEGIN
04500		WEST1;
04600		SOUTH2;
04700	END 	ELSE	GO NOSHOW;
04800		RETURN(3);
04900	NOSHOW:	IF QNE<0  ∧  QNW<0  ∧  QSW<0  ∧  QSE<0  THEN RETURN(4)	α PURELY EXTERIOR;
05000		ELSE RETURN(5);						α NO EXTERIOR;
05100	END; END